home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Run Magazine ReRun: Productivity Pak 3
/
rerun-productivity-pak-iii-side-a.d64
/
runfile 64.bas
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-09-20
|
18KB
|
622 lines
10 rem *************************
20 rem program : runfile 1.0
30 rem author : david darus
40 rem date : 6/15/87
50 rem update : 7/30/87
60 rem computer: c64
70 rem *************************
80 rem command file=1 seq file=2 rel file=3
90 rem set up variables
98 dn=8
100 def fnh(a)=int(a/256):def fnl(a)=a-(rh*256)
110 print"[147][154]"chr$(8)chr$(14)
140 x=0:y=0:sw=0:c=0:t=0:t1=0:nc=0:hc=0:cc=0:ec=0:a=0:l=0:en=0:tr=0:sc=0:nf=0
150 fc=0:nd=0:fl=0:tx=0:ty=0:ox=0:oy=0:nm=0:al=0:ky=0:sp=0:vn=0:tl=0:pl=0:ct=0
160 ef=0:mr=0:nl=0:rn=0:nr=0:of=0
165 f1=133:f3=134:f5=135:f7=136:f2=137:f4=138:f6=139:f8=140
170 rl=0:rh=0:rs=0:re=0:rm=0:ip=0:kf=0:kl=0:kp=0:rp=0:r$="":r1$="":ky$=""
180 cm$="":sp$="":a$="":an$="":er$="":dn$="":ss$="":xp$="":yp$=""
190 for t=1 to 80:xp$=xp$+"":yp$=yp$+"":sp$=sp$+" ":ul$=ul$+"[164]":next
200 ss$=chr$(160):pd$=""
210 c=1:hc=2:cc=15:nc=6:ns=6:ec=8:of=0
220 nl=22:vn=0:rn=0
230 sw=40:mr=1000:ct=0:poke 53280,0:poke 53281,0:poke 808,234:goto 280
240 rem sw=40:mr=2000:ct=1:slow:rem trap 21000
250 if peek(215)=128 then sw=80:(NULL)%
270 (NULL)0,1:(NULL)1,1:(NULL)4,1:(NULL)6,1:(NULL)5,15
272 (NULL)1,chr$(133):(NULL)3,chr$(134):(NULL)5,chr$(135):(NULL)7,chr$(136)
274 (NULL)2,chr$(137):(NULL)4,chr$(138):(NULL)6,chr$(139):(NULL)8,chr$(140)
280 dimcr$(16),cx(nc),cy(nc),cm$(nc),tx$(18),fl$(nl),sx(ns),sy(ns),sm$(ns)
290 mf=30:a=mf+1:dim fx(a),fy(a),fl(a),ft(a),ft$(a),fq(a),fo(a)
300 dim ix(mr),rd$(mr),si(mr)
310 fort=1to16:cr$(t)=mid$("[144][159][156][158][129][149][150][151][152][153][154][155]",t,1):next
320 cm$="[195][207][205][205][193][206][196][211]:[154] [195]lose [197]dit [206]ew [207]pen [213]tils e[216]it"
330 fort=1 to nc:read cy(t),cx(t),cm$(t):next
340 data 23,10,"[195]lose",23,16,"[197]dit",23,21,"[206]ew",23,25,"[207]pen",23,30,"[213]tils"
350 data 23,36,"e[216]it"
352 sm$="[213][212][201][204][211]:[154] [196]ir [196]os [196]rive#08 [208]rint [211]eq [213]sr"
353 for t=1 to ns:read sy(t),sx(t),sm$(t):next
354 data 23,7,"[196]ir",23,11,"[196]os",23,15,"[196]rive#08",23,24,"[208]rint",23,30,"[211]eq"
355 data 23,34,"[213]sr"
360 for t=1 to 18:read tx$(t):next
370 data "[210]un [198]ile 1.0","[196]atabase:","[204]en=","[212]ype:","[193]lpha","[203]ey","[206]um"
380 data "[211]pecial","[211]earching for field","[198]ile:","[212]otal="
390 data "[197]stimated # of records","[204]oading database parameters"
392 data " "
394 data "[211]elect fields in desired export order "
396 data "[211]ort (y/n)","[210]eplace record (y/n)","#recs"
400 rem set up screen
410 print"[147]":x=0:y=22:gosub2210
420 printcr$(ec);:for t=1 to sw:print"[192]";:next:x=0:gosub2210:printtx$(1);
430 x=0:y=23:gosub2210:printcm$;
440 rem get commands
450 c=1:gosub 5110
460 x=cx(c):y=cy(c):gosub2210:print""cr$(hc);cm$(c);"[146]";
470 geta$:ifa$=""then470
480 x=cx(c):y=cy(c):gosub2210:printcr$(cc);cm$(c);
490 ifa$=chr$(13)then660
500 ifa$=""then600
510 ifa$="[157]"then630
520 ifa$="c"then710
530 ifa$="e"then810
540 ifa$="n"then1110
550 ifa$="o"then1210
560 ifa$="u"then1610
570 ifa$="x"then1710
580 goto460
590 rem cursor right
600 c=c+1:ifc>ncthenc=1
610 goto460
620 rem cursor left
630 c=c-1:ifc<1thenc=nc
640 goto460
650 rem return
660 on c goto 710,810,1110,1210,1610,1710:goto470
700 rem close database
710 if of=0 then 450
715 open 1,dn,15,"i":print#1,"s:\\temp.i":close1
720 of=0:open 2,dn,2,"\\temp.i,u,w":nr=ix(0)
730 rh=fnh(nr):rl=fnl(nr):print#2,"indx";chr$(vn);chr$(rl);chr$(rh);
740 if nr=0 then 760
750 for t=1 to nr:rh=fnh(ix(t)):rl=fnl(ix(t)):print#2,chr$(rl);chr$(rh);:next
760 close2
770 open1,dn,15,"s:"+dn$+"bi":print#1,"r:"+dn$+"bi="+dn$+".i"
780 print#1,"r:"+dn$+".i=\\temp.i":close1
785 for t=1 to nl:fl$(t)="":next
790 goto 410
800 rem edit database
810 if of=0 then 1030
820 pd$=ul$:fc=1:nd=0:pl=tl
830 open1,dn,15:open3,dn,3,dn$+".d"
840 al=0:ky=0:nm=0:sp=0:gosub 5110:x=0:y=24:gosub2210:print tx$(4);
850 if ft(fc) and 1 then x=6:y=24:gosub 2210:print""+tx$(5)+"[146]";:al=1
860 if ft(fc) and 2 then x=12:y=24:gosub 2210:print""+tx$(6)+"[146]";:ky=1
870 if ft(fc) and 4 then x=16:y=24:gosub 2210:print""+tx$(7)+"[146]";:nm=1
880 if ft(fc) and 8 then x=20:y=24:gosub 2210:print""+tx$(8)+"[146]";:sp=1
885 x=sw-11:y=24:gosub 2210:print tx$(18);nr;
890 x=fx(fc):y=fy(fc):l=fl(fc):an$=ft$(fc)
900 print cr$(ec);
910 gosub 3430:t=fl(fc)-len(an$):ft$(fc)=an$+left$(pd$,t)
920 if a$=chr$(13) and fc=nf then 840
930 if a$="" or a$=chr$(13) then fc=fc+1:if fc>nf then fc=1
940 if a$="[145]" then fc=fc-1:if fc<1 then fc=nf
950 if ct=1 and asc(a$+chr$(0))=27 then a$=""
960 if a$="" then 1020
970 if a$=chr$(f1) then gosub 5310:fc=1:rem find rec
975 if a$=chr$(f2) then gosub 2110:fc=1:rem write rec
980 if a$=chr$(f3) then kf=1:gosub 1855:fc=1:rem first rec
985 if a$=chr$(f4) then kf=ix(0):gosub 1855:fc=1:rem last rec
990 if a$=chr$(f5) then gosub 1950:fc=1:rem read next
995 if a$=chr$(f6) then gosub 1850:fc=1:rem read prev
1000 if a$=chr$(f7) then gosub 4010:fc=1:rem clear form fields
1005 if a$=chr$(f8) then gosub 4060:fc=1:rem print form fields
1010 goto 840
1020 close3:close1
1030 gosub1696:goto430
1100 rem new database
1110 if of=1 then 450
1120 x=0:y=24:gosub2210:print tx$(2);:l=14:x=9:gosub 2320
1130 if a$="" then dn$="":goto 410
1140 if an$="" then 1120
1150 open 2,dn,2,an$+".f,u,r":gosub 5140:close2
1160 if en=0 then 1110
1170 if en<>62 then gosub 5060:goto 410
1180 nf=22:for t=1 to nf:fx(t)=0:fy(t)=t-1:fl(t)=sw-1:ft$(t)=left$(sp$,sw-2)+ss$
1190 x=fx(t):y=fy(t):gosub2210:print ft$(t);
1195 ft(t)=0:next:dn$=an$:gosub 2790:dn$="":goto 410
1200 rem open database
1210 if of=1 then 1500
1220 gosub 5110
1225 x=0:y=24:gosub2210:print tx$(2);:l=14:x=9:gosub 2320:if a$="" then 1500
1230 if an$="" then 1220
1240 open 2,dn,2,an$+".f,u,r":gosub 5140:close2:if en<>0 then 1220
1250 x=0:y=24:gosub2210:print tx$(13);
1260 tl=0:gosub 3310:if ef=-1 then 1220
1270 dn$=an$:open 2,dn,2,dn$+".i,u,r":gosub 5140:close2
1280 if en=0 then 1380
1290 if en<>62 then gosub 5060:goto 410
1300 rem create database
1310 gosub5110:x=0:y=24:gosub2210:print tx$(12);:l=4:x=23:gosub2320
1320 rn=val(an$):if rn=0 then 1310
1330 if rn>mr then rn=mr
1340 open 2,dn,2,dn$+".i,u,w":print#2,"indx";chr$(vn);chr$(0);chr$(0);:close2
1350 open1,dn,15:open3,dn,3,dn$+".d,l,"+chr$(tl):rh=fnh(rn):rl=fnl(rn)
1360 rp=1:gosub5010:print#3,chr$(255);:gosub 5010:close3:close1:gosub 5140
1370 rem read in database index,parms
1380 of=1:x=sw-22:y=22:gosub2210:printtx$(10);dn$;:t1=1
1390 for t=1 to nl:x=0:y=t-1:gosub 2210
1400 if ct=0 then print ft$(t);
1410 if ct=1 then print left$(ft$(t),sw-1);
1420 next:for t=1 to nf:t1=t1+fl(t):if(ft(t)and2)<>0 then kl=fl(t):kp=t1-kl:k1=t
1430 ft$(t)=left$(ul$,fl(t)):next:tl=t1-1
1440 open 2,dn,2,dn$+".i,u,r"
1450 get#2,a$,a$,a$,a$:get#2,a$:vn=asc(a$+chr$(0))
1460 get#2,a$,b$:nr=asc(a$+chr$(0))+(asc(b$+chr$(0))*256):ix(0)=nr
1470 if nr=0 then 1490
1480 for t=1 to nr:get#2,a$,b$:ix(t)=asc(a$+chr$(0))+(asc(b$+chr$(0))*256):next
1490 close2
1500 goto450
1600 rem utils database
1610 gosub 4210:goto 430
1612 rem select fields
1615 if of=0 then return
1620 pd$=sp$:fc=1:so=1:for t=1 to nf:fq(t)=0:fo(t)=0:next
1622 if fr=2 then x=0:y=23:gosub 2210:print"[211]elect field to search on ";:goto 1630
1625 x=0:y=23:gosub 2210:print tx$(15);
1630 an$=ft$(fc):l=fl(fc):x=fx(fc):y=fy(fc)
1632 if fr=0 or fr=2 then 1638
1633 get a$:if a$="" then 1633
1634 if ct=1 and asc(a$+chr$(0))=27 then a$=""
1635 if a$="" then return
1636 goto 1633
1638 printcr$(ec);:gosub5200:printcr$(cc);
1640 if a$=chr$(13) and fq(fc)=0 then fq(fc)=so:fo(so)=fc:so=so+1:if fr=2 then fr=1
1645 if a$="" or a$=chr$(13) then fc=fc+1:if fc>nf then fc=1
1650 if a$="[145]" then fc=fc-1:if fc<1 then fc=nf
1655 if ct=1 and asc(a$+chr$(0))=27 then a$=""
1657 if a$="" then return
1659 goto 1630
1660 rem make usr file
1662 gosub5110:x=0:y=24:gosub 2210:print tx$(16);:l=1:y=24:x=11:gosub 2320
1665 if an$="n" or an$="[206]" or an$="y" or an$="[217]" then 1675
1667 goto 1660
1670 rem build output records
1675 gosub 6010
1680 rem sort records
1685 if an$="y" or an$="[217]" then gosub 7010
1690 rem output export file
1691 if c=4 then gosub 8310
1692 if c=5 then gosub 8210
1695 if c=6